home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / xlisp21.zip / STEP.LSP < prev    next >
Lisp/Scheme  |  1988-02-12  |  5KB  |  114 lines
  1. ;Title:  step.lsp
  2. ;Author: Jonathan Engdahl (jengdahl on BIX)
  3. ;Date:   Jan-25-1987
  4.  
  5. ;This file contains a simple Lisp single-step debugger. It
  6. ;started as an implementation of the "hook" example in chapter 20
  7. ;of Steele's "Common Lisp". This version was brought up on Xlisp 1.7
  8. ;for the Amiga, and then on VAXLISP.
  9.  
  10. ;To invoke: (step (whatever-form with args))
  11. ;For each list (interpreted function call), the stepper prints the
  12. ;environment and the list, then enters a read-eval-print loop
  13. ;At this point the available commands are:
  14.  
  15. ;    (a list)<CR> - evaluate the list in the current environment,
  16. ;                   print the result, and repeat.                 
  17. ;    <CR> - step into the called function
  18. ;    anything_else<CR> - step over the called function.
  19.  
  20. ;If the stepper comes to a form that is not a list it prints the form 
  21. ;and the value, and continues on without stopping.
  22.  
  23. ;Note that stepper commands are executed in the current environment.
  24. ;Since this is the case, the stepper commands can change the current
  25. ;environment. For example, a SETF will change an environment variable
  26. ;and thus can alter the course of execution.
  27.  
  28.  
  29. ;set the representation for an input #/newline
  30. ;the value, notation, and data type of newline may be implementation dependent
  31. (setf newline #\newline)   ;for VAXLISP
  32. ;(setf newline 10)           ;for XLISP
  33.  
  34. ;define a C-like iterator.
  35. (defmacro while (test &rest forms) `(do () ((not ,test)) ,@forms))
  36.  
  37. ;create the nesting level counter.
  38. (setf *hooklevel* 0)
  39.  
  40. ;this macro invokes the stepper.
  41. ;for VAXLISP you better rename this to xstep or something, lest
  42. ;defun say nasty things to you about step already being defined
  43.  
  44. (defmacro step (form &aux val)
  45.      `(progn
  46.        (step-flush)                  ;get rid of garbage on the line
  47.        (setf *hooklevel* 0)          ;init nesting counter
  48.        (princ *hooklevel*)           ;print the form
  49.        (princ "  form: ")
  50.        (prin1 ',form)
  51.        (terpri)
  52.        (setf val (evalhook ',form    ;eval, and kick off stepper
  53.                            #'eval-hook-function
  54.                            nil
  55.                            nil))
  56.        (princ *hooklevel*)           ;print returned value
  57.        (princ " value: ")
  58.        (prin1 val)
  59.        (terpri)
  60.        val))                         ;and return it
  61.  
  62.  
  63. ;this is the substitute "eval" routine that gets control when
  64. ;a user form is evaluated during stepping.
  65.  
  66. (defun eval-hook-function (form env &aux val f1)
  67.      (setf *hooklevel* (+ *hooklevel* 1))    ;inc the nesting level
  68.      (cond ((consp form)                     ;if interpreted function 
  69.             (step-spaces *hooklevel*)        ;print the environment
  70.             (princ *hooklevel*)
  71.             (princ "    env: ")
  72.             (prin1 env)
  73.             (terpri)
  74.             (step-spaces *hooklevel*)        ;then the form
  75.             (princ *hooklevel*)
  76.             (princ "   form: ")
  77.             (prin1 form)
  78.             (princ " ")
  79.             (while (eql (peek-char) #\( )    ;while a form is typed           
  80.                    (setf f1 (read))          ;read a form
  81.                    (step-flush)              ;get rid of junk
  82.                    (step-spaces *hooklevel*) ;print out result
  83.                    (princ *hooklevel*)
  84.                    (princ " result: ")       ;which is evaled in env
  85.                    (prin1 (evalhook f1 nil nil env))
  86.                    (princ " "))   
  87.             (cond ((eql (read-char) newline) ;if <cr> then step into
  88.                    (setf val (evalhook form
  89.                                        #'eval-hook-function
  90.                                        nil
  91.                                        env)))
  92.                   (t (step-flush)            ;else step over
  93.                      (setf val (evalhook form nil nil env)))))
  94.            (t (step-spaces *hooklevel*)      ;if not interpreted func
  95.               (princ *hooklevel*)            ;print the form
  96.               (princ "   form: ")
  97.               (prin1 form)
  98.               (terpri)
  99.               (setf val (evalhook form nil nil env)))) ;eval it
  100.      (step-spaces *hooklevel*)               ;in either case
  101.      (princ *hooklevel*)                     ;print the result
  102.      (princ "  value: ")
  103.      (prin1 val)
  104.      (terpri)
  105.      (setf *hooklevel* (- *hooklevel* 1))    ;decrement level
  106.      val)                                    ;and return the value
  107.  
  108.  
  109. ;a non-recursive fn to print spaces (not as elegant, easier on the gc)
  110. (defun step-spaces (n) (while (> n 0) (princ " ") (setf n (- n 1))))
  111.      
  112. ;and one to clear the input buffer
  113. (defun step-flush () (while (not (eql (read-char) newline))))
  114.